home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / PALETTE.INC < prev    next >
Text File  |  1991-09-30  |  11KB  |  359 lines
  1. { PALETTE.INC: Support for large-palette multicolor graphics in SURFMODL. }
  2.  
  3. { RGB2pal: Convert RGB triplet into a Palettetype record }
  4. procedure RGB2pal (r, g, b: integer; var col: ColorValue);
  5. begin
  6.   with col do begin
  7.       { Make sure values are valid }
  8.       if r < 0 then
  9.       Rvalue := 0
  10.     else if r > RGB_levels then
  11.       Rvalue := RGB_levels
  12.     else
  13.       Rvalue := r;
  14.  
  15.       if g < 0 then
  16.       Gvalue := 0
  17.     else if g > RGB_levels then
  18.       Gvalue := RGB_levels
  19.     else
  20.       Gvalue := g;
  21.  
  22.       if b < 0 then
  23.       Bvalue := 0
  24.     else if b > RGB_levels then
  25.       Bvalue := RGB_levels
  26.     else
  27.       Bvalue := b;
  28.   end;
  29. end; { procedure RGB2pal }
  30.  
  31. { def_palette: Define the graphics palette for all materials. }
  32. procedure def_palette (Nmatl: integer);
  33. var Mat: integer;       { material # }
  34.     Done: boolean;      { are we done searching for correct # steps? }
  35.     Del: array[1..3] of integer; { deltas for R, G and B }
  36.     Nsteps: integer;    { # color steps from 0 to full intensity }
  37.     i: integer;
  38.     j: integer;
  39.     Shade: real;
  40.     curr: integer;    { current color # being printed }
  41.     r, g, b: integer;
  42. begin
  43.   if RGB_levels > 1 then begin
  44.     { Set the maximum number of colors used per material }
  45.     Maxcol_mat := (Ncolors-RESERVED_COLORS) div Nmatl;
  46.     if MAXSHADES < Maxcol_mat then
  47.       Maxcol_mat := MAXSHADES;
  48.     if RGB_levels < Maxcol_mat then
  49.       Maxcol_mat := RGB_levels;
  50.     if Maxcol_mat < 2 then begin
  51.       restorecrtmode;
  52.       writeln;
  53.       writeln ('ERROR: Not enough colors to define a palette!');
  54.       writeln ('You have ', Nmatl, ' materials and only ',
  55.           Ncolors-RESERVED_COLORS, ' colors available.');
  56.       writeln ('  (need at least 2 colors per material).');
  57. {$ifdef USE_IFF}
  58.       writeln ('This file can not be displayed with SURFIFF.');
  59. {$else}
  60.       writeln ('Suggest you set your GRSYS to VGA without 256-color');
  61.       writeln ('  capability, or use EGA instead.');
  62. {$endif}
  63.       halt(1);
  64.     end;
  65. {$ifdef DEBUG}
  66.     writeln(Dbgfile, 'Ncolors=', Ncolors, ' Maxcol_mat=', Maxcol_mat);
  67. {$endif}
  68.     { if grsys = VGA256 then begin }
  69.       { Reserve some colors for their standard EGA values: }
  70.       for curr := 0 to RESERVED_COLORS-1 do begin
  71.         color_to_rgb (curr, r, g, b);
  72.         if grsys = VGA256 then begin
  73.           { These came back in 1..256 range, so scale to 0..RGB_levels }
  74.           r := r * (RGB_levels + 1) div 256 - 1;
  75.           g := g * (RGB_levels + 1) div 256 - 1;
  76.           b := b * (RGB_levels + 1) div 256 - 1;
  77. {$IFDEF USE_IFF}
  78.         end else if grsys = IFF then begin
  79.           { These came back in 1..256 range, so make them 0..255 }
  80.           r := r - 1;
  81.           g := g - 1;
  82.           b := b - 1;
  83. {$ENDIF}
  84.         end;
  85.         RGB2pal (r, g, b, VGApal[curr]);
  86. {$ifdef DEBUG}
  87.           writeln(Dbgfile, 'RESPAL ', curr, ': ',
  88.               VGApal[curr].Rvalue, ', ', VGApal[curr].Gvalue, ', ',
  89.               VGApal[curr].Bvalue);
  90. {$endif}
  91.       end;
  92.     { end; { if grsys = VGA256 }
  93.  
  94.     { Do for each material }
  95.     for Mat := 1 to Nmatl do begin
  96.       { Redmax, etc. are in the range 1..256 so we scale them to the proper
  97.         range for the device (0..RGB_levels) }
  98.       Del[1] := round ((1.0 + RGB_levels) * Redmax[Mat] / 256.0) - 1;
  99.       Del[2] := round ((1.0 + RGB_levels) * Grnmax[Mat] / 256.0) - 1;
  100.       Del[3] := round ((1.0 + RGB_levels) * Blumax[Mat] / 256.0) - 1;
  101.       for i := 1 to 3 do
  102.         if Del[i] < 0 then
  103.           Del[i] := 0;
  104. {$ifdef DEBUG}
  105.       writeln(Dbgfile, 'MAT ', Mat, ' RGB max=', Redmax[Mat], ', ',
  106.           Grnmax[Mat], ', ', Blumax[Mat]);
  107.       writeln(Dbgfile, '  Dels=', Del[1], ', ', Del[2], ', ', Del[3]);
  108. {$endif}
  109.  
  110. {$IFDEF PURE_RGB}
  111.       { Calculate the number of color steps for this matl. Note that we only
  112.         choose "pure" colors, that is, colors with RGB components that are
  113.         exactly proportional to the maximum RGB components.  Therefore you
  114.         will use more colors if you choose maximum values that are evenly
  115.         divisible.
  116.       }
  117.       { The largest possible # color steps is the smallest of: (1) the number 
  118.         of RGB levels on the device; (2) the max # colors allowed per 
  119.         material; and (3) the smallest of the RGB components that is > 0.
  120.       }
  121.       if RGB_levels < Maxcol_mat then
  122.         Nsteps := RGB_levels
  123.       else
  124.         Nsteps := Maxcol_mat;
  125.       for i := 1 to 3 do
  126.         if (Del[i] > 0) and (Del[i] < Nsteps) then
  127.           Nsteps := Del[i];
  128.  
  129.       { Find a # color steps that evenly divides into each of the RGB levels }
  130.       repeat
  131.         Done := TRUE;
  132.         for i := 1 to 3 do
  133.           if (Del[i] div Nsteps) * Nsteps <> Del[i] then
  134.             Done := FALSE;
  135.         if not Done then begin
  136.           Nsteps := Nsteps - 1;
  137.           if Nsteps = 1 then
  138.             Done := TRUE;
  139.         end;
  140.       until Done;
  141. {$ELSE} {PURE_RGB}
  142.       { In this version we do not restrict ourselves to "pure" RGB colors.
  143.         Instead we just use the maximum number of colors available that
  144.         will provide unique values.
  145.       }
  146.       { Start with the largest of the 3 color components }
  147.       Nsteps := 1;
  148.       for i := 1 to 3 do
  149.         if Del[i] > Nsteps then
  150.           Nsteps := Del[i];
  151.       { Then reduce according to the maximum number of colors allowed }
  152.       if Maxcol_mat < Nsteps then
  153.         Nsteps := Maxcol_mat;
  154. {$ENDIF} {PURE_RGB}
  155.  
  156.       Ncol_mat[Mat] := Nsteps;
  157. {$ifdef DEBUG}
  158.       writeln(Dbgfile, 'MAT ', Mat, ' Ncol_mat=', Nsteps);
  159. {$endif}
  160.  
  161.       if Nsteps = 0 then begin
  162.         restorecrtmode;
  163.         writeln ('ERROR Nsteps=0 Maxcol_mat=', Maxcol_mat);
  164.         halt(1);
  165.       end;
  166.       Shade := 1.0 / Nsteps;
  167.       curr := (Mat-1) * Maxcol_mat + RESERVED_COLORS;
  168.       for i := 1 to Nsteps do begin
  169.         RGB2pal (round (Shade * Del[1]),
  170.             round (Shade * Del[2]), round (Shade * Del[3]), VGApal[curr]);
  171. {$ifdef DEBUG}
  172.         writeln(Dbgfile, '  Step ', i, ' Shade=', Shade:6:3, ' curr=', curr,
  173.             ': ',
  174.             VGApal[curr].Rvalue, ', ', VGApal[curr].Gvalue, ', ',
  175.             VGApal[curr].Bvalue);
  176. {$endif}
  177.         Shade := Shade + 1.0 / Nsteps;
  178.         curr := curr + 1;
  179.       end;
  180.       { Set unused colors to black }
  181.       for i := Nsteps+1 to Maxcol_mat do begin
  182.         RGB2pal (0, 0, 0, VGApal[curr]);
  183. {$ifdef DEBUG}
  184.         writeln(Dbgfile, '  BLACK Step ', i, ' curr=', curr, ': ',
  185.             VGApal[curr].Rvalue, ', ', VGApal[curr].Gvalue, ', ',
  186.             VGApal[curr].Bvalue);
  187. {$endif}
  188.         curr := curr + 1;
  189.       end;
  190.         
  191.     end; { for Mat }
  192.  
  193.     { Inform the device of the new palette changes }
  194.  
  195.     if grsys = VGA256 then
  196.       VGASetAllPalette (VGApal);
  197.  
  198.   end else begin { if RGB_levels }
  199.     for Mat := 1 to Nmatl do
  200.       Ncol_mat[Mat] := 1;
  201.   end;
  202. end; { procedure def_palette }
  203.  
  204. { FINDCOLORS: Find the appropriate color numbers to use that bracket
  205.   the desired shade, for large-palette devices
  206. }
  207. procedure findcolors (Mat, Matcolor: integer; var Shade: real; var Color1, Color2:
  208.   integer);
  209. var col: integer;
  210.     i: integer;
  211.     Tshade: real;
  212.     Dshade: real;
  213.     Lshade: real;
  214. label FOUNDSHADE;
  215. begin
  216.   if (RGB_levels < 2) or (Mat = 0) then begin
  217. {$ifdef NEVER}
  218.     if RevVideo then begin
  219. {$endif}
  220.       { KVC 09/27/91 - Not sure why these colors need to be reversed, but
  221.         it works this way on my Hercules:
  222.       }
  223.       Color2 := 0;
  224.       { Make sure the color is legitimate }
  225.       if (Matcolor > Ncolors) then
  226.         Color1 := Ncolors
  227.       else
  228.         Color1 := Matcolor;
  229. {$ifdef NEVER}
  230.     end else begin
  231.       Color1 := 0;
  232.       { Make sure the color is legitimate }
  233.       if (Matcolor > Ncolors) then
  234.         Color2 := Ncolors
  235.       else
  236.         Color2 := Matcolor;
  237.     end;
  238. {$endif}
  239.   end else begin
  240.     if Shade < 0.0 then
  241.       Shade := 0.0
  242.     else if Shade > 1.0 then
  243.       Shade := 1.0;
  244.     { Find 2 colors with intensities that bracket the one we want }
  245.     { First find start of colors for this matl }
  246.     Col := (Mat-1) * Maxcol_mat + RESERVED_COLORS;
  247.     Dshade := 1.0 / Ncol_mat[Mat];
  248.     Tshade := Dshade;
  249.     for i := 1 to Ncol_mat[Mat] do begin
  250.       if Shade <= Tshade then begin
  251.         { Found the right shades to bracket }
  252.         if i = 1 then begin
  253.           Color1 := 0;   { black }
  254.           Lshade := 0.0;
  255.         end else begin
  256.           Color1 := Col + i - 2;
  257.           Lshade := Tshade - Dshade;
  258.         end;
  259.         Color2 := Col + i - 1;
  260.         { The new shade is relative to the 2 shades that bracket it }
  261.         Shade := (Shade - Lshade) / Dshade;
  262.         { Done searching }
  263.         goto FOUNDSHADE;
  264.       end;
  265.       Tshade := Tshade + Dshade;
  266.     end;
  267.  
  268.     { Did not find shade - use highest }
  269.     if Ncol_mat[Mat] = 1 then begin
  270.       Color1 := 0;    { black }
  271.       Lshade := 0.0;
  272.     end else begin
  273.       Color1 := Col + Ncol_mat[Mat] - 2;
  274.       Lshade := 1.0 - Dshade;
  275.     end;
  276.     Color2 := Col + Ncol_mat[Mat] - 1;
  277.     { The new shade is relative to the 2 shades that bracket it }
  278.     Shade := (Shade - Lshade) / (1.0 - Lshade);
  279.  
  280.     FOUNDSHADE:
  281.   end; { if RGB_levels }
  282. end; { procedure findcolors }
  283.  
  284. { COLOR_TO_RGB: Convert an old PC-style color number to its RGB components.
  285.   This routine should be fixed up, as these RGB levels are not quite right.
  286. }
  287. procedure color_to_rgb (Color: integer; var Red, Grn, Blu: integer);
  288. begin
  289.   case Color of
  290.     0: begin { black }
  291.       Red := 1; Grn := 1; Blu := 1;
  292.     end;
  293.  
  294.     1: begin { blue (dark) }
  295.       Red := 1; Grn := 1; Blu := 176;           { ??? }
  296.     end;
  297.  
  298.     2: begin { green }
  299.       Red := 1; Grn := 176; Blu := 1;
  300.     end;
  301.  
  302.     3: begin { cyan }
  303.       Red := 1; Grn := 176; Blu := 176;
  304.     end;
  305.  
  306.     4: begin { red}
  307.       Red := 256; Grn := 1; Blu := 80;          { ??? }
  308.     end;
  309.  
  310.     5: begin { magenta }
  311.       Red := 176; Grn := 1; Blu := 176;
  312.     end;
  313.  
  314.     6: begin { brown }
  315.       Red := 256; Grn := 128; Blu := 256;       { ??? }
  316.     end;
  317.  
  318.     7: begin { lightgray }
  319.       Red := 80; Grn := 80; Blu := 80;
  320.     end;
  321.  
  322.     8: begin { darkgray }
  323.       Red := 176; Grn := 176; Blu := 176;
  324.     end;
  325.  
  326.     9: begin { lightblue }
  327.       Red := 1; Grn := 1; Blu := 256;
  328.     end;
  329.  
  330.     10: begin { lightgreen }
  331.       Red := 1; Grn := 256; Blu := 1;
  332.     end;
  333.  
  334.     11: begin { lightcyan }
  335.       Red := 1; Grn := 256; Blu := 256;
  336.     end;
  337.  
  338.     12: begin { lightred }
  339.       Red := 256; Grn := 1; Blu := 176;
  340.     end;
  341.  
  342.     13: begin { lightmagenta }
  343.       Red := 256; Grn := 1; Blu := 256;
  344.     end;
  345.  
  346.     14: begin { yellow }
  347.       Red := 256; Grn := 256; Blu := 80;
  348.     end;
  349.  
  350.     15: begin { white }
  351.       Red := 256; Grn := 256; Blu := 256;
  352.     end;
  353.  
  354.     else begin { undefined color = white }
  355.       Red := 256; Grn := 256; Blu := 256;
  356.     end;
  357.   end; { case }
  358. end; { procedure color_to_rgb }
  359.